home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr11 / gedvw105.zip / AHNEN.PRG next >
Text File  |  1995-03-05  |  2KB  |  138 lines
  1. *
  2. *    Generates a simple Ahnentafel for current INDI record and save
  3. *    it as $LASTNAME.AHN.
  4. *
  5. *    for GEDView 1.05
  6. *    michael@genealogy.emcee.com - 3 Mar 1995
  7. *
  8. get line
  9. compare INDI $FIELD3
  10. iffailed
  11.     goto error
  12. set #index 0
  13. set #ahnen 1
  14. set #counter 1
  15. get name
  16. fixname
  17. set #outfile $LASTNAME.ahn
  18. save $OUTFILE "\I\IAhnentafel for Ancestors of "
  19. append $OUTFILE $FULLNAME
  20. append $OUTFILE "\J"
  21. set #1 $NUMBER
  22. gosub save-it
  23.  
  24. :repeat
  25.     gosub write-data
  26.  
  27.     * get current indi's ahnen
  28.     add 1 #counter
  29.  
  30.     * reset
  31.     set #ahnen $$COUNTER    
  32.  
  33.     * double it for parents
  34.     add $$COUNTER #ahnen
  35.     gosub get-parents
  36.  
  37.     add 2 #counter
  38.     compare $COUNTER $INDEX
  39.     ifequal
  40.         goto the-end
  41.     add -1 #counter
  42.     go $$COUNTER
  43.     ifescape
  44.         goto the-end
  45.     goto repeat
  46.  
  47. :the-end
  48.     add -1 #counter
  49.     go $$COUNTER
  50.     gosub write-data
  51.     append $OUTFILE "\J\J--\J\J"
  52.     set #width 60
  53.     append $OUTFILE "GEDView 1.05\J"
  54.     go $1
  55.     end
  56.  
  57. :get-parents
  58.     get famc
  59.     iffailed
  60.         return
  61.     fixpointer #field3
  62.     go fam $FIELD3
  63.     iffailed
  64.         return
  65.     remember record
  66.  
  67.     get husb
  68.     iffailed
  69.         goto get-wife
  70.     fixpointer $field3
  71.     go indi $FIELD3
  72.     iffailed
  73.         return
  74.     gosub save-it
  75.     go record
  76.  
  77. :get-wife
  78.     get wife
  79.     iffailed
  80.         return
  81.     fixpointer $field3
  82.     go indi $FIELD3
  83.     iffailed
  84.         return
  85.     add 1 #ahnen
  86.     gosub save-it
  87.     return
  88.  
  89. :save-it
  90.     add 1 #index
  91.     set #$INDEX $NUMBER
  92.     add 1 #index
  93.     set #$INDEX $AHNEN
  94.     return
  95.  
  96. *  This assumes that the date record (if it exists)
  97. *  follows immediately after the event record.
  98. *
  99. :write-data
  100.     add 1 #counter
  101.     get name
  102.     fixname
  103.     append $OUTFILE "\J"
  104.     set #width 5
  105.     append $OUTFILE $$COUNTER
  106.     set #width -0
  107.     append $OUTFILE ". "
  108.     append $OUTFILE $FULLNAME
  109.     add -1 #counter
  110.     get birt
  111.     iffailed
  112.         return
  113.     get next line
  114.     compare $FIELD2 date
  115.     ifequal
  116.         gosub print-date2
  117.  
  118.     get deat
  119.     iffailed
  120.         return
  121.     append $OUTFILE " - "
  122.     get next line
  123.     compare $FIELD2 date
  124.     ifequal
  125.         append $OUTFILE $FIELD3
  126.     return
  127.  
  128. :print-date2
  129.     append $OUTFILE ", "
  130.     append $OUTFILE $FIELD3
  131.     return
  132.  
  133. :error
  134.     bell
  135.     show Not an INDI record. Press a key to continue ...
  136.     pause
  137.     end
  138.